home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / prim / process.el.z / process.el
Encoding:
Text File  |  1998-05-21  |  14.0 KB  |  338 lines
  1. ;;; process.el --- commands for subprocesses; split out of simple.el
  2.  
  3. ;; Copyright (C) 1985-1987, 1993, 1994, 1997 Free Software Foundation, Inc.
  4. ;; Copyright (C) 1995 Ben Wing.
  5.  
  6. ;; Author: Ben Wing
  7. ;; Maintainer: XEmacs Development Team
  8. ;; Keywords: internal, processes
  9.  
  10. ;; This file is part of XEmacs.
  11.  
  12. ;; XEmacs is free software; you can redistribute it and/or modify it
  13. ;; under the terms of the GNU General Public License as published by
  14. ;; the Free Software Foundation; either version 2, or (at your option)
  15. ;; any later version.
  16.  
  17. ;; XEmacs is distributed in the hope that it will be useful, but
  18. ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  19. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  20. ;; General Public License for more details.
  21.  
  22. ;; You should have received a copy of the GNU General Public License
  23. ;; along with XEmacs; see the file COPYING.  If not, write to the 
  24. ;; Free Software Foundation, 59 Temple Place - Suite 330,
  25. ;; Boston, MA 02111-1307, USA.
  26.  
  27. ;;; Synched up with: FSF 19.30.
  28.  
  29. ;;; Commentary:
  30.  
  31. ;;; Code:
  32.  
  33.  
  34. (defvar shell-command-switch "-c"
  35.   "Switch used to have the shell execute its command line argument.")
  36.  
  37. (defun start-process-shell-command (name buffer &rest args)
  38.   "Start a program in a subprocess.  Return the process object for it.
  39. Args are NAME BUFFER COMMAND &rest COMMAND-ARGS.
  40. NAME is name for process.  It is modified if necessary to make it unique.
  41. BUFFER is the buffer or (buffer-name) to associate with the process.
  42.  Process output goes at end of that buffer, unless you specify
  43.  an output stream or filter function to handle the output.
  44.  BUFFER may be also nil, meaning that this process is not associated
  45.  with any buffer
  46. Third arg is command name, the name of a shell command.
  47. Remaining arguments are the arguments for the command.
  48. Wildcards and redirection are handled as usual in the shell."
  49.   (cond
  50.    ((eq system-type 'vax-vms)
  51.     (apply 'start-process name buffer args))
  52.    ;; We used to use `exec' to replace the shell with the command,
  53.    ;; but that failed to handle (...) and semicolon, etc.
  54.    (t
  55.     (start-process name buffer shell-file-name shell-command-switch
  56.            (mapconcat 'identity args " ")))))
  57.  
  58. (defun call-process (program &optional infile buffer displayp &rest args)
  59.   "Call PROGRAM synchronously in separate process.
  60. The program's input comes from file INFILE (nil means `/dev/null').
  61. Insert output in BUFFER before point; t means current buffer;
  62.  nil for BUFFER means discard it; 0 means discard and don't wait.
  63. BUFFER can also have the form (REAL-BUFFER STDERR-FILE); in that case,
  64. REAL-BUFFER says what to do with standard output, as above,
  65. while STDERR-FILE says what to do with standard error in the child.
  66. STDERR-FILE may be nil (discard standard error output),
  67. t (mix it with ordinary output), or a file name string.
  68.  
  69. Fourth arg DISPLAYP non-nil means redisplay buffer as output is inserted.
  70. Remaining arguments are strings passed as command arguments to PROGRAM.
  71.  
  72. If BUFFER is 0, `call-process' returns immediately with value nil.
  73. Otherwise it waits for PROGRAM to terminate and returns a numeric exit status
  74.  or a signal description string.
  75. If you quit, the process is killed with SIGINT, or SIGKILL if you
  76.  quit again."
  77.   (apply 'call-process-internal program infile buffer displayp args))
  78.  
  79. (defun call-process-region (start end program
  80.                             &optional deletep buffer displayp
  81.                             &rest args)
  82.   "Send text from START to END to a synchronous process running PROGRAM.
  83. Delete the text if fourth arg DELETEP is non-nil.
  84.  
  85. Insert output in BUFFER before point; t means current buffer;
  86.  nil for BUFFER means discard it; 0 means discard and don't wait.
  87. BUFFER can also have the form (REAL-BUFFER STDERR-FILE); in that case,
  88. REAL-BUFFER says what to do with standard output, as above,
  89. while STDERR-FILE says what to do with standard error in the child.
  90. STDERR-FILE may be nil (discard standard error output),
  91. t (mix it with ordinary output), or a file name string.
  92.  
  93. Sixth arg DISPLAYP non-nil means redisplay buffer as output is inserted.
  94. Remaining args are passed to PROGRAM at startup as command args.
  95.  
  96. If BUFFER is 0, returns immediately with value nil.
  97. Otherwise waits for PROGRAM to terminate
  98. and returns a numeric exit status or a signal description string.
  99. If you quit, the process is first killed with SIGINT, then with SIGKILL if
  100. you quit again before the process exits."
  101.   (let ((temp (cond ((eq system-type 'vax-vms)
  102.                      (make-temp-name "tmp:emacs"))
  103.             ((or (eq system-type 'ms-dos)
  104.              (eq system-type 'windows-nt))
  105.              (make-temp-name
  106.               (concat (file-name-as-directory
  107.                    (or (getenv "TMP")
  108.                    (getenv "TEMP")
  109.                    ""))
  110.                    "em")))
  111.                     (t
  112.                      (make-temp-name "/tmp/emacs")))))
  113.     (unwind-protect
  114.     (progn
  115.       (if (or (eq system-type 'ms-dos)
  116.           (eq system-type 'windows-nt))
  117.           (let ((buffer-file-type binary-process-output))
  118.         (write-region start end temp nil 'silent))
  119.         (write-region start end temp nil 'silent))
  120.       (if deletep (delete-region start end))
  121.       (apply #'call-process program temp buffer displayp args))
  122.       (condition-case ()
  123.           (delete-file temp)
  124.         (file-error nil)))))
  125.  
  126.  
  127. (defun shell-command (command &optional output-buffer)
  128.   "Execute string COMMAND in inferior shell; display output, if any.
  129.  
  130. If COMMAND ends in ampersand, execute it asynchronously.
  131. The output appears in the buffer `*Async Shell Command*'.
  132. That buffer is in shell mode.
  133.  
  134. Otherwise, COMMAND is executed synchronously.  The output appears in the
  135. buffer `*Shell Command Output*'.
  136. If the output is one line, it is displayed in the echo area *as well*,
  137. but it is nonetheless available in buffer `*Shell Command Output*',
  138. even though that buffer is not automatically displayed.
  139. If there is no output, or if output is inserted in the current buffer,
  140. then `*Shell Command Output*' is deleted.
  141.  
  142. The optional second argument OUTPUT-BUFFER, if non-nil,
  143. says to put the output in some other buffer.
  144. If OUTPUT-BUFFER is a buffer or buffer name, put the output there.
  145. If OUTPUT-BUFFER is not a buffer and not nil,
  146. insert output in current buffer.  (This cannot be done asynchronously.)
  147. In either case, the output is inserted after point (leaving mark after it)."
  148.   (interactive (list (read-shell-command "Shell command: ")
  149.              current-prefix-arg))
  150.   (if (and output-buffer
  151.        (not (or (bufferp output-buffer)  (stringp output-buffer))))
  152.       (progn (barf-if-buffer-read-only)
  153.          (push-mark)
  154.          ;; We do not use -f for csh; we will not support broken use of
  155.          ;; .cshrcs.  Even the BSD csh manual says to use
  156.          ;; "if ($?prompt) exit" before things which are not useful
  157.          ;; non-interactively.  Besides, if someone wants their other
  158.          ;; aliases for shell commands then they can still have them.
  159.          (call-process shell-file-name nil t nil
  160.                shell-command-switch command)
  161.          (exchange-point-and-mark t))
  162.     ;; Preserve the match data in case called from a program.
  163.     (save-match-data
  164.       (if (string-match "[ \t]*&[ \t]*$" command)
  165.       ;; Command ending with ampersand means asynchronous.
  166.       (progn
  167.         (background (substring command 0 (match-beginning 0))))
  168.     (shell-command-on-region (point) (point) command output-buffer)))))
  169.  
  170. ;; We have a sentinel to prevent insertion of a termination message
  171. ;; in the buffer itself.
  172. (defun shell-command-sentinel (process signal)
  173.   (if (memq (process-status process) '(exit signal))
  174.       (message "%s: %s." 
  175.            (car (cdr (cdr (process-command process))))
  176.            (substring signal 0 -1))))
  177.  
  178. (defun shell-command-on-region (start end command
  179.                       &optional output-buffer replace)
  180.   "Execute string COMMAND in inferior shell with region as input.
  181. Normally display output (if any) in temp buffer `*Shell Command Output*';
  182. Prefix arg means replace the region with it.
  183.  
  184. The noninteractive arguments are START, END, COMMAND, OUTPUT-BUFFER, REPLACE.
  185. If REPLACE is non-nil, that means insert the output
  186. in place of text from START to END, putting point and mark around it.
  187.  
  188. If the output is one line, it is displayed in the echo area,
  189. but it is nonetheless available in buffer `*Shell Command Output*'
  190. even though that buffer is not automatically displayed.
  191. If there is no output, or if output is inserted in the current buffer,
  192. then `*Shell Command Output*' is deleted.
  193.  
  194. If the optional fourth argument OUTPUT-BUFFER is non-nil,
  195. that says to put the output in some other buffer.
  196. If OUTPUT-BUFFER is a buffer or buffer name, put the output there.
  197. If OUTPUT-BUFFER is not a buffer and not nil,
  198. insert output in the current buffer.
  199. In either case, the output is inserted after point (leaving mark after it)."
  200.   (interactive (let ((string
  201.               ;; Do this before calling region-beginning
  202.               ;; and region-end, in case subprocess output
  203.               ;; relocates them while we are in the minibuffer.
  204.               (read-shell-command "Shell command on region: ")))
  205.          ;; call-interactively recognizes region-beginning and
  206.          ;; region-end specially, leaving them in the history.
  207.          (list (region-beginning) (region-end)
  208.                string
  209.                current-prefix-arg
  210.                current-prefix-arg)))
  211.   (if (or replace
  212.       (and output-buffer
  213.            (not (or (bufferp output-buffer) (stringp output-buffer)))))
  214.       ;; Replace specified region with output from command.
  215.       (let ((swap (and replace (< start end))))
  216.     ;; Don't muck with mark unless REPLACE says we should.
  217.     (goto-char start)
  218.     (and replace (push-mark))
  219.     (call-process-region start end shell-file-name t t nil
  220.                  shell-command-switch command)
  221.     (let ((shell-buffer (get-buffer "*Shell Command Output*")))
  222.       (and shell-buffer (not (eq shell-buffer (current-buffer)))
  223.            (kill-buffer shell-buffer)))
  224.     ;; Don't muck with mark unless REPLACE says we should.
  225.     (and replace swap (exchange-point-and-mark t)))
  226.       ;; No prefix argument: put the output in a temp buffer,
  227.       ;; replacing its entire contents.
  228.     (let ((buffer (get-buffer-create
  229.            (or output-buffer "*Shell Command Output*")))
  230.       (success nil)
  231.       (directory default-directory))
  232.       (unwind-protect
  233.       (if (eq buffer (current-buffer))
  234.           ;; If the input is the same buffer as the output,
  235.           ;; delete everything but the specified region,
  236.           ;; then replace that region with the output.
  237.           (progn (setq buffer-read-only nil)
  238.              (delete-region (max start end) (point-max))
  239.              (delete-region (point-min) (max start end))
  240.              (call-process-region (point-min) (point-max)
  241.                       shell-file-name t t nil
  242.                       shell-command-switch command)
  243.              (setq success t))
  244.         ;; Clear the output buffer, 
  245.         ;; then run the command with output there.
  246.         (save-excursion
  247.           (set-buffer buffer)
  248.           (setq buffer-read-only nil)
  249.           ;; XEmacs change
  250.           (setq default-directory directory)
  251.           (erase-buffer))
  252.         (call-process-region start end shell-file-name
  253.                  nil buffer nil
  254.                  shell-command-switch command)
  255.         (setq success t))
  256.     ;; Report the amount of output.
  257.     (let ((lines (save-excursion
  258.                (set-buffer buffer)
  259.                (if (= (buffer-size) 0)
  260.                0
  261.              (count-lines (point-min) (point-max))))))
  262.       (cond ((= lines 0)
  263.          (if success
  264.              (display-message
  265.               'command
  266.               "(Shell command completed with no output)"))
  267.          (kill-buffer buffer))
  268.         ((and success (= lines 1))
  269.          (message "%s"
  270.               (save-excursion
  271.                 (set-buffer buffer)
  272.                 (goto-char (point-min))
  273.                 (buffer-substring (point)
  274.                           (progn (end-of-line)
  275.                              (point))))))
  276.         (t 
  277.          (set-window-start (display-buffer buffer) 1))))))))
  278.  
  279.  
  280. (defun start-process (name buffer program &rest program-args)
  281.   "Start a program in a subprocess.  Return the process object for it.
  282. Args are NAME BUFFER PROGRAM &rest PROGRAM-ARGS
  283. NAME is name for process.  It is modified if necessary to make it unique.
  284. BUFFER is the buffer or (buffer-name) to associate with the process.
  285.  Process output goes at end of that buffer, unless you specify
  286.  an output stream or filter function to handle the output.
  287.  BUFFER may be also nil, meaning that this process is not associated
  288.  with any buffer
  289. Third arg is program file name.  It is searched for as in the shell.
  290. Remaining arguments are strings to give program as arguments.
  291. INCODE and OUTCODE specify the coding-system objects used in input/output
  292.  from/to the process."
  293.   (apply 'start-process-internal name buffer program program-args))
  294.  
  295. (defun open-network-stream (name buffer host service)
  296.   "Open a TCP connection for a service to a host.
  297. Returns a subprocess-object to represent the connection.
  298. Input and output work as for subprocesses; `delete-process' closes it.
  299. Args are NAME BUFFER HOST SERVICE.
  300. NAME is name for process.  It is modified if necessary to make it unique.
  301. BUFFER is the buffer (or buffer-name) to associate with the process.
  302.  Process output goes at end of that buffer, unless you specify
  303.  an output stream or filter function to handle the output.
  304.  BUFFER may be also nil, meaning that this process is not associated
  305.  with any buffer
  306. Third arg is name of the host to connect to, or its IP address.
  307. Fourth arg SERVICE is name of the service desired, or an integer
  308.  specifying a port number to connect to."
  309.   (open-network-stream-internal name buffer host service))
  310.  
  311. (defun shell-quote-argument (argument)
  312.   "Quote an argument for passing as argument to an inferior shell."
  313.   (if (eq system-type 'ms-dos)
  314.       ;; MS-DOS shells don't have quoting, so don't do any.
  315.       argument
  316.     (if (eq system-type 'windows-nt)
  317.     (concat "\"" argument "\"")
  318.       ;; Quote everything except POSIX filename characters.
  319.       ;; This should be safe enough even for really weird shells.
  320.       (let ((result "") (start 0) end)
  321.     (while (string-match "[^-0-9a-zA-Z_./]" argument start)
  322.       (setq end (match-beginning 0)
  323.         result (concat result (substring argument start end)
  324.                    "\\" (substring argument end (1+ end)))
  325.         start (1+ end)))
  326.     (concat result (substring argument start))))))
  327.  
  328. (defun exec-to-string (command)
  329.   "Execute COMMAND as an external process and return the output of that
  330. process as a string"
  331.   ;; by "William G. Dubuque" <wgd@zurich.ai.mit.edu>
  332.   (with-output-to-string
  333.     (call-process shell-file-name nil t nil "-c" command)))
  334.  
  335. (defalias 'shell-command-to-string 'exec-to-string)
  336.  
  337. ;;; process.el ends here
  338.